home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / manchest.lha / MANCHESTER / usenet / st80_pre4 / ContextMods.st < prev    next >
Text File  |  1993-07-24  |  5KB  |  138 lines
  1. "    NAME        ContextMods
  2.     AUTHOR        jans@tekgvs.LABS.TEK.COM (Jan Steinman)
  3.     FUNCTION    Assorted context functions
  4.     ST-VERSION    2.2
  5.     PREREQUISITES    
  6.     CONFLICTS
  7.     DISTRIBUTION    world
  8.     VERSION        1
  9.     DATE    27 Apr 1989
  10. SUMMARY Contains assorted method for accessing contexts
  11. "
  12.  
  13. '
  14. Newsgroups: comp.lang.smalltalk
  15. Subject: Re: Polymorphism (really, contexts)
  16. Message-ID: <5014@tekgvs.LABS.TEK.COM>
  17. Organization: Tektronix Inc., Beaverton, Or.
  18.  
  19. <<Given a method, you can find out the names of its temporaries, and given a 
  20. context, you can find out the method that invoked it, but it is not very 
  21. convenient.>>
  22.  
  23. <How do you do that?>
  24.  
  25. Many of these sorts of things are accessible through "thisContext", which is a 
  26. first-class object that describes the execution state of a method:
  27.  
  28. 1) "thisContext tempNames" returns the names of temporary variables.
  29.  
  30. 2) "thisContext selector" returns the name of the method.
  31.  
  32. If using these in a method, what you probably really want is "thisContext 
  33. sender ...", which is the context of the method that called the one that is 
  34. executing.  If you want to send a message to the object that called you, rather
  35. than it''s current execution state, try "thisContext sender receiver ...".
  36.  
  37. Agreed, it''s messy, but can be useful.  When I had a bunch of methods that 
  38. differed only by one datum, but for some reason (like use from a menu) I didn''t 
  39. want to pass an argument, I set up a bunch of "relay methods", that were really 
  40. only additional method dictionary keys for one method.  That method then 
  41. determined which selector it was called by, and took the apropriate action.  
  42. (Sort of like shell scripts with references to "$0" in them.)
  43.  
  44. Here''s some more fun things to do with contexts.  I especially find 
  45. "isRecursive" invaluable.  This works with Tek Smalltalk.  PPS Smalltalk <= 2.3 
  46. will require some hacking, and I have no idea if it will work at all in 
  47. Smalltalk/V.  The blockish ones probalby won''t work at all for >= PPS 2.4, 
  48. because they are no longer Blue-Book compatible.  (If you own it, you can do 
  49. what you want with it, I guess.)
  50.  
  51.  
  52.  
  53. :::::: Jan Steinman - N7JDB           Electronic Systems Laboratory ::::::
  54. :::::: jans@tekgvs.LABS.TEK.COM          Box 500, MS 50-370 (w)503/627-5881 ::::::
  55. :::::: jsteinma@caip.RUTGERS.EDU     Beaverton, OR 97077 (h)503/657-7703 ::::::
  56. '
  57.  
  58. 'From Tektronix Smalltalk-80 version TB2.2.2a of May 05, 1988, 18:14:03.'!
  59.  
  60. '$Header: ContextMods.st,v 1.1 89/02/13 12:35:51 jans Exp $'!
  61.  
  62. "The following methods add various functionality to Contexts."!
  63.  
  64. !BlockContext methodsFor: 'accessing'!
  65.  
  66. argCount
  67.         "Return the number of arguments the receiver expects."
  68.  
  69.         ^nargs! !
  70.  
  71. !BlockContext methodsFor: 'testing'!
  72.  
  73. isEmpty
  74.     "Is this block devoid of any code?  Is the block only big enough for pushing 
  75. args and returning?"
  76.  
  77.     ^(self method at: startpc-2) \\ 16 - 4 * 16r100 + (self method at: startpc-1) 
  78. - nargs = 2! !
  79.  
  80. !ContextPart methodsFor: 'message handling'!
  81.  
  82. sendersDo: aBlock
  83.     "Cause each object in the stack to execute <aBlock> with itself as the 
  84. argument."
  85.  
  86.     | ctx |
  87.     ctx _ self home.
  88.         [aBlock value: ctx receiver.
  89.         (ctx _ ctx sender) == nil] whileFalse:
  90.             [ctx _ ctx home "skip intervening contexts"]!
  91.  
  92. senderPerform: selector withArguments: args ifAbsent: exception
  93.     "Look for an object in the stack who can respond to <selector>.  Send that 
  94. object the message <selector> with the arguments <args>.  If no respondents are 
  95. found, execute <exception>."
  96.  
  97.     self sendersDo: [:receiver | (receiver respondsTo: selector)
  98.         ifTrue: [^receiver perform: selector withArguments: args]].
  99.     exception!
  100.  
  101. senderClass: aClass perform: selector withArguments: args
  102.     "Look for an object in the stack of class <aClass> and send it the message 
  103. <selector> with the arguments <args>, returning the result."
  104.  
  105.     self sendersDo: [:receiver | receiver class == aClass
  106.         ifTrue: [^receiver perform: selector withArguments: args]].
  107.     exception! !
  108.  
  109. self notify:
  110. 'My version of this has original Xerox code.  To avoid
  111. copyright problems, I turned it into a relay.  Rename
  112. "printOn:" to "printOnOld:" before proceeding."'!
  113.  
  114. !ContextPart methodsFor: 'printing'!
  115.  
  116. printOn: aStream
  117.     "Print a textual representation of this context on <aStream>, as either class 
  118. and selector, or source code."
  119.  
  120.     | mclass selector class |
  121.     Sensor leftShiftDown ifTrue: [^aStream cr; nextPut: $'; nextPutAll: self 
  122. sourceCode; nextPut: $'].
  123.     self printOnOld: aStream! !
  124.  
  125. !ContextPart methodsFor: 'testing'!
  126.  
  127. isRecursive
  128.     "Does the sender's receiver and method appear previously in this context?"
  129.  
  130.     | ctx obj meth |
  131.     ctx _ self home.
  132.     obj _ self receiver.
  133.     meth _ self method.
  134.         [(ctx _ ctx sender) == nil] whileFalse:
  135.             [ctx _ ctx home.        "Optimization: skip intervening contexts."
  136.             (ctx method == meth and: [ctx receiver == obj]) ifTrue: [^true]].
  137.     ^false! !
  138.